home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / tegl6b.zip / INTROPAK.EXE / lha / TWDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1991-08-14  |  17KB  |  497 lines
  1. {$I switches.inc}
  2. {-------------------------------------------------------------------}
  3. { TWDEMO.PAS                                                        }
  4. { Copyright 1991 TEGL SYSTEMS CORPORATION, All rights reserved.     }
  5. {-------------------------------------------------------------------}
  6.  
  7.  
  8. {$F+} {-- far  call is necessary for EVENTS }
  9.  
  10. Uses
  11.   teglfont,  {-- the graphics group }
  12.   fastgrph,
  13.   tgraph,
  14.  
  15.   virtmem,   {-- memory }
  16.  
  17.   teglintr,
  18.   teglunit,  {-- window manager, menus and micellaneous }
  19.   teglmenu,
  20.   teglmain,
  21.   teglspec,
  22.  
  23.   twcommon,  {-- high-level windows }
  24.   twkernel,
  25.   twwindow,
  26.   twworld,
  27.   twdialog,
  28.   twcontrl;
  29.  
  30.  
  31. {-- Global variables }
  32.  
  33. VAR
  34.   TechnaFont : Integer;
  35.   TallFont   : Integer;
  36.   mainmenu: ImageStkPtr;   {-- the main bar menu is only an ordinary frame}
  37.                {-- with option menu click areas placed on it. }
  38.   menufont: pointer;       {-- the font to use with all menus. Set once so }
  39.                {-- we can make the program look better on }
  40.                {-- a variety of video displays. }
  41.   fileom   : optionmptr;
  42.   devicesom: optionmptr;
  43.   dialogom : optionmptr;
  44.   worldom  : optionmptr;
  45.  
  46. {-- restores all the frames to being active and close the error }
  47. {-- message window. }
  48.  
  49. function errorclose(ifs: imagestkptr; ms: msclickptr): Word;
  50.   BEGIN
  51.     resetframeactive(stackptr,true);
  52.     twclose(findwinframe(ifs));
  53.   END;
  54.  
  55. {-- Display an error message and disable all other frames until }
  56. {-- the OK button is pressed. }
  57.  
  58. procedure SayError(s: String);
  59.   VAR wf : WinFramePtr;
  60.   BEGIN
  61.     { resetframeactive sets the activity of all the frames from }
  62.     { the one passed (here the topmost) to the bottom of the stack.}
  63.     { In this case all frames become inactive then we create one }
  64.     { active frame (the error message) that must be delt with, before}
  65.     { processing can continue. }
  66.     resetframeactive(stackptr,false);  {-- disable everything }
  67.     twdInit(wf,0,(getmaxy DIV 2) - 35,getmaxx,(getmaxy DIV 2) + 35);
  68.       twsetHeader(wf,'ERROR');  {-- set the header }
  69.       twSetMaximize(wf,false);  {-- disable MIN/MAX buttons }
  70.       {-- add a button that will acknowlege the error }
  71.       twdAddButton(wf,getmaxx DIV 2 - 20, 25, 'OK',errorclose);
  72.       twsetcloseevent(wf,errorclose);  {-- space bar menu CLOSE }
  73.     twDrawWindowFrame(wf);   {-- finally draw the window }
  74.     {-- display the message. }
  75.     prepareforupdate(wf^.ifs);  {-- going to write to the window }
  76.       settextjustify(centertext,toptext);
  77.       OutTextXY((getmaxx DIV 2) - (wf^.thickness *2),5,s);
  78.     commitupdate;              {-- finished writing to the window }
  79.   END;
  80. {---------------------------------------------------------}
  81. {-- These are some global variable for our dialog window to access }
  82.  
  83.   CONST wf : WinFramePtr = NIL;
  84.     strtd: string[20] = 'This is a string';
  85.         chkbox : boolean = TRUE;
  86.         radio : integer = 2;
  87.  
  88. {-- Note that closing a dialog calls twdClose not twClose, it must}
  89. {-- first dispose of the list of dialog entries before the window }
  90.  
  91. function dialogclose(ifs : ImageStkPtr; ms: MsClickPtr): Word;
  92.   begin
  93.     dialogclose := twdClose(ifs,ms);
  94.     wf := NIL;
  95.   end;
  96.  
  97. {-- Opens up a simple dialog window. }
  98.  
  99. Function OpenDialogDemo(ifs: ImageStkPtr; ms: MsClickPtr): Word;
  100.   VAR tempifs : imagestkptr;
  101.   BEGIN
  102.     if wf <> NIL then     {-- only one allowed. }
  103.       begin
  104.     sayerror('The dialog demo is already running.');
  105.     exit;
  106.       end;
  107.     twdInit(wf,100,100,400,300);
  108.       twSetHeader(wf,'Simple Dialogue');
  109.  
  110.       twdAddLabel(wf,10,10,'Labels go anywhere');
  111.       {-- input lines are string items, the last parameter is the }
  112.       {-- length of the string. }
  113.       twdAddInputLine(wf,10,30,'Edit this ',strtd,20);
  114.       {-- check boxes are boolean values }
  115.       twdAddCheckBox(wf,10,50,'a check box',chkbox);
  116.       {-- radio buttons all access the same integer value. Their }
  117.       {-- order is important. The first one will be one the }
  118.       {-- second two, etc. Groups of radio buttons must be seperated }
  119.       {-- by either some other dialog item or a label, if nothing is }
  120.       {-- required use an empty label. }
  121.       twdAddRadioButton(wf,10,70,'a radio button (1)',radio);
  122.       twdAddRadioButton(wf,10,90,'a radio button (2)',radio);
  123.       twdAddRadioButton(wf,10,110,'a radio button (3)',radio);
  124.       {-- Buttons are associated with events, here the OK button does }
  125.       {-- nothing, but the cancel button closes the dialog. }
  126.       twdAddbutton(wf,50,150,'OK',nilunitproc);
  127.       twdAddButton(wf,180,150,'CANCEL',dialogclose);
  128.       twSetCloseEvent(wf,dialogclose);  {-- the space bar menu }
  129.  
  130.     {-- Note that the window is only drawn AFTER ALL THE DIALOG ITEMS }
  131.     {-- HAVE BEEN SET. }
  132.     twDrawWindowFrame(wf);
  133.   END;
  134.  
  135. {-- The key to using scaled text is by setting the usercharsize }
  136. {-- with the ratio of the working area to the screen size }
  137.  
  138. Function WorldTextRedraw(ifs: ImageStkPtr; ms: MsClickPtr): Word;
  139.   VAR wf: WinFramePtr;
  140.   BEGIN
  141.     wf := FindWinFrame(ifs);
  142.     twSelect(wf);
  143.     twwDefineWorld(wf,0,0,1000,1000);
  144.     PrepareforUpdate(ifs);
  145.     SetTextJustify(lefttext,toptext);
  146.     SetTextStyle(TechnaFont,horizdir,2);
  147.     SetUserCharSize(wf^.wx2-wf^.wx1,getmaxx DIV 2,
  148.                      wf^.wy2-wf^.wy1,getmaxy DIV 2);
  149.     twwOutTextXY(wf,10,10,'Scaled text');
  150.     SetTextStyle(TallFont,Horizdir,5);
  151.     SetUserCharSize(wf^.wx2-wf^.wx1,getmaxx DIV 2,
  152.                      wf^.wy2-wf^.wy1,getmaxy DIV 2);
  153.     twwOutTextXY(wf,10,500,'Using Triplex & Small Font');
  154.     CommitUpDate;
  155.  
  156.   END;
  157.  
  158. Function OpenWorldTextDemo(ifs: ImageStkPtr; ms: MsClickPtr): Word;
  159.   VAR wf : WinFramePtr;
  160.   BEGIN
  161.     twinit(wf,100,100,300,250);
  162.       twSetHeader(wf,'Scaling text');
  163.       twSetRedraw(wf,WorldTextRedraw);
  164.     twDrawWindowFrame(wf);
  165.   END;
  166.  
  167.  
  168. {---------------------------------------------------------}
  169. {-- Bar graph demo illustrates how to use the world coordinates }
  170. {-- to fit data into any sized window. }
  171. {---------------------------------------------------------}
  172.  
  173. CONST MaxBars = 10;
  174. TYPE BarDef = RECORD x1,y1,x2,y2,color: Integer; END;
  175. CONST Bars : Array[1..MaxBars] OF BarDef =
  176.     (
  177.     (x1:-99;y1:80;x2:-81;y2:0;Color:blue),
  178.     (x1:-80;y1:70;x2:-61;y2:0;Color:blue),
  179.     (x1:-60;y1:20;x2:-41;y2:0;Color:blue),
  180.     (x1:-40;y1:0;x2:-21;y2:-40;Color:red),
  181.     (x1:-20;y1:0;x2:-1;y2:-99;Color:red),
  182.     (x1:1;y1:0;x2:20;y2:-67;Color:red),
  183.     (x1:21;y1:8;x2:40;y2:0;Color:green),
  184.     (x1:41;y1:20;x2:60;y2:0;Color:yellow),
  185.     (x1:61;y1:75;x2:80;y2:0;Color:magenta),
  186.     (x1:81;y1:50;x2:99;y2:0;Color:blue));
  187.  
  188.  
  189.  
  190. Function rtos(r: real) : string;
  191.   var s : String;
  192.   BEGIN
  193.     str(r:5:1,s);
  194.     rtos := s;
  195.   END;
  196.  
  197. Function WorldBarRedraw(ifs : ImageStkPtr; ms : MsClickPtr): Word;
  198.   VAR wf: WinFramePtr;
  199.       I : Integer;
  200.   BEGIN
  201.     wf := FindWinFrame(ifs);
  202.     twwDefineWorld(wf,-100,100,100,-100);
  203.     twwLine(wf,-100,0,100,0);
  204.     twSetFont(wf,@f6x6norm);
  205.     for I := 1 to MaxBars DO
  206.       WITH BARS[I] DO
  207.         BEGIN
  208.           SetFillStyle(solidfill,color);
  209.           twwBar(wf,x1,y1,x2,y2);
  210.           SetColor(Black);
  211.           twwRectangle(wf,x1,y1,x2,y2);
  212.           {twwOutTextXy(wf,x1,y1,'('+rtos(x1)+','+rtos(y1)+')'); }
  213.  
  214.         END;
  215.     SetColor(BLACK);
  216.     {twwOutTextXy(wf,-10,-10,'(0,0)');}
  217.   END;
  218.  
  219. Function WorldSinRedraw(ifs : ImageStkPtr; ms : MsClickPtr): Word;
  220.   VAR wf: WinFramePtr;
  221.       t : real;
  222.   const
  223.     counter : real = 0.05;
  224.     range   : real = 8.0;
  225.   BEGIN
  226.     wf := FindWinFrame(ifs);
  227.     twwDefineWorld(wf,-(range * 1.2),(range * 1.2),(range * 1.2),-(range * 1.2));
  228.     twwline(wf,-range,0,range,0);
  229.     twwline(wf,0,-range,0,range);
  230.     twwline(wf,-range,range,-range,-range);
  231.     twwline(wf,-range,-range,range,-range);
  232.     setcolor(red);
  233.     t := -range;
  234.     while t <= range do
  235.       begin
  236.         { twwputpixel(wf,t,range * sin(t),red); }
  237.  
  238.         twwline(wf,t,range * sin(t),t+counter,range * sin(t+counter));
  239.         t := t + counter;
  240.       end;
  241.  
  242.     setcolor(black);
  243.   END;
  244.  
  245. Function OpenWorldBarDemo(